home *** CD-ROM | disk | FTP | other *** search
/ Gold Medal Software 1 / Gold Medal Software Volume 1 (Gold Medal) (1994).iso / prog / tpwprog4.arj / OWLSPY.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1992-07-02  |  8.3 KB  |  347 lines
  1. {******************************************************************}
  2. {                                                                  }
  3. {     OwlSpy                                                       }
  4. {     Turbo Pascal for Windows                                     }
  5. {     Copyright (c) 1991 by Swan Software. All rights reserved.    }
  6. {                                                                  }
  7. {******************************************************************}
  8.  
  9. { owlspy.pas -- A program for spying on other windows }
  10.  
  11. {$R owlspy.res}
  12.  
  13. program OwlSpy;
  14.  
  15. uses WinTypes, WinProcs, WObjects, Strings, IDs;
  16.  
  17. const
  18.  
  19.   infoWinWidth  = 300;
  20.   infoWinHeight = 250;
  21.  
  22. type
  23.  
  24.   TSpyApp = object(TApplication)
  25.     procedure InitInstance; virtual;
  26.     procedure InitMainWindow; virtual;
  27.   end;
  28.  
  29.   PTInfoWin = ^TInfoWin;
  30.   TInfoWin = object(TWindow)
  31.     ButtonDown: Boolean;
  32.     HaveInfo: Boolean;
  33.     DC: HDC;
  34.     WindowRect: TRect;
  35.     WindowCaption: array[0 .. 80] of Char;
  36.     constructor Init(AParent: PWindowsObject; Origin: TPoint);
  37.     procedure WMLButtonDown(var Msg: TMessage);
  38.       virtual wm_First + wm_LButtonDown;
  39.     procedure WMLButtonUp(var Msg: TMessage);
  40.       virtual wm_First + wm_LButtonUp;
  41.     procedure Paint(PaintDC: HDC; var PaintStruct: TPaintStruct);
  42.       virtual;
  43.   end;
  44.  
  45.   PTSpyWin = ^TSpyWin;
  46.   TSpyWin = object(TWindow)
  47.     ButtonDown: Boolean;
  48.     DC: HDC;
  49.     InfoWin: PTInfoWin;
  50.     Lx, Ly, Gx, Gy: Word;
  51.     constructor Init(AParent: PWindowsObject; ATitle: PChar);
  52.     procedure GetWindowClass(var AWndClass: TWndClass); virtual;
  53.     function GetClassName: PChar; virtual;
  54.     procedure SetCursorInfo(X, Y: Word);
  55.     procedure CMFileExit(var Msg: TMessage);
  56.       virtual cm_First + cm_FileExit;
  57.     procedure CMWindowGetInfo(var Msg: TMessage);
  58.       virtual cm_First + cm_WindowGetInfo;
  59.     procedure CMHelpAbout(var Msg: TMessage);
  60.       virtual cm_First + cm_HelpAbout;
  61.     procedure WMMouseMove(var Msg: TMessage);
  62.       virtual wm_First + wm_MouseMove;
  63.     procedure WMLButtonDown(var Msg: TMessage);
  64.       virtual wm_First + wm_LButtonDown;
  65.     procedure WMLButtonUp(var Msg: TMessage);
  66.       virtual wm_First + wm_LButtonUp;
  67.     procedure Paint(PaintDC: HDC; var PaintInfo: TPaintStruct);
  68.       virtual;
  69.   end;
  70.  
  71.  
  72. { TSpyApp }
  73.  
  74.  
  75. { Initialize this program instance }
  76.  
  77. procedure TSpyApp.InitInstance;
  78. begin
  79.   TApplication.InitInstance;
  80.   HAccTable := LoadAccelerators(HInstance, PChar(id_Acc));
  81. end;
  82.  
  83.  
  84. { Initialize TSpyApp's main window }
  85.  
  86. procedure TSpyApp.InitMainWindow;
  87. begin
  88.   MainWindow := New(PTSpyWin, Init(nil, 'OWL Spy Utility'));
  89. end;
  90.  
  91.  
  92.  
  93. { TInfoWin }
  94.  
  95. { Construct instance of TInfoWin object }
  96.  
  97. constructor TInfoWin.Init(AParent: PWindowsObject; Origin: TPoint);
  98. begin
  99.   TWindow.Init(AParent, 'Window Information');
  100.   with Attr do
  101.   begin
  102.     Style := ws_PopUp or ws_OverlappedWindow or ws_Visible;
  103.     X := Origin.X;
  104.     Y := Origin.Y;
  105.     W := infoWinWidth;
  106.     H := infoWinHeight;
  107.   end;
  108.   ButtonDown := false;
  109.   HaveInfo := false;
  110. end;
  111.  
  112.  
  113. { Respond to left-mouse-button-down event }
  114.  
  115. procedure TInfoWin.WMLButtonDown(var Msg: TMessage);
  116. begin
  117.   if not ButtonDown then
  118.   begin
  119.     ButtonDown := true;
  120.     SetCapture(HWindow);
  121.     DC := GetDC(HWindow);
  122.     SetCursor(LoadCursor(0, idc_UpArrow));
  123.     HaveInfo := false;
  124.   end;
  125. end;
  126.  
  127.  
  128. { Respond to release of left mouse button }
  129.  
  130. procedure TInfoWin.WMLButtonUp(var Msg: TMessage);
  131. var
  132.   P: TPoint;    { Cursor location }
  133.   HW: HWnd;     { Handle to window under cursor }
  134. begin
  135.   if ButtonDown then
  136.   begin
  137.     ReleaseCapture;
  138.     ReleaseDC(HWindow, DC);
  139.     ButtonDown := false;
  140.     GetCursorPos(P);
  141.     HW := WindowFromPoint(P);
  142.     GetWindowText(HW, WindowCaption, Sizeof(WindowCaption) - 1);
  143.     GetWindowRect(HW, WindowRect);
  144.     HaveInfo := true;
  145.     InvalidateRect(HWindow, nil, true);
  146.     UpdateWindow(HWindow);
  147.     SetCursor(LoadCursor(0, idc_Arrow));
  148.   end;
  149. end;
  150.  
  151.  
  152. { Display information in the information window }
  153.  
  154. procedure TInfoWin.Paint(PaintDC: HDC; var PaintStruct: TPaintStruct);
  155. var
  156.   S: array[0 .. 20] of Char;
  157. begin
  158.   TWindow.Paint(PaintDC, PaintStruct);
  159.   if HaveInfo then
  160.   begin
  161.     TextOut(PaintDC, 10, 10, WindowCaption, StrLen(WindowCaption));
  162.     with WindowRect do
  163.     begin
  164.       WVSPrintf(S, 'Top = %5d ', Top);
  165.       TextOut(PaintDC, 10, 40, S, StrLen(S));
  166.       WVSPrintf(S, 'Left = %5d ', Left);
  167.       TextOut(PaintDC, 10, 70, S, StrLen(S));
  168.       WVSPrintf(S, 'Right = %5d ', Right);
  169.       TextOut(PaintDC, 10, 100, S, StrLen(S));
  170.       WVSPrintf(S, 'Bottom = %5d ', Bottom);
  171.       TextOut(PaintDC, 10, 130, S, StrLen(S));
  172.     end;
  173.   end;
  174. end;
  175.  
  176.  
  177. { TSpyWin }
  178.  
  179.  
  180. { Construct a TSpyWin object }
  181.  
  182. constructor TSpyWin.Init(AParent: PWindowsObject; ATitle: PChar);
  183. begin
  184.   TWindow.Init(AParent, ATitle);
  185.   with Attr do
  186.   begin
  187.     Menu := LoadMenu(HInstance, PChar(id_Menu));
  188.     X := GetSystemMetrics(sm_CXScreen) div 8;
  189.     Y := GetSystemMetrics(sm_CYScreen) div 8;
  190.     H := Y * 6;
  191.     W := X * 6;
  192.   end;
  193.   InfoWin := nil;
  194.   ButtonDown := false;
  195.   SetCursorInfo(0, 0);
  196. end;
  197.  
  198.  
  199. { Return window "class" information }
  200.  
  201. procedure TSpyWin.GetWindowClass(var AWndClass: TWndClass);
  202. begin
  203.   TWindow.GetWindowClass(AWndClass);
  204.   AWndClass.HIcon := LoadIcon(HInstance, PChar(id_Icon));
  205. end;
  206.  
  207.  
  208. { Return window "class" name }
  209.  
  210. function TSpyWin.GetClassName: PChar;
  211. begin
  212.   GetClassName := 'TSpyWin';
  213. end;
  214.  
  215.  
  216. { Initialize cursor location variables }
  217.  
  218. procedure TSpyWin.SetCursorInfo(X, Y: Word);
  219. var
  220.   P: TPoint;
  221. begin
  222.   GetCursorPos(P);
  223.   Lx := X;
  224.   Ly := Y;
  225.   Gx := P.X;
  226.   Gy := P.Y;
  227. end;
  228.  
  229.  
  230. { Execute the File menu's Exit command }
  231.  
  232. procedure TSpyWin.CMFileExit(var Msg: TMessage);
  233. begin
  234.   CloseWindow;
  235. end;
  236.  
  237.  
  238. { Execute Window:Get info... command }
  239.  
  240. procedure TSpyWin.CMWindowGetInfo(var Msg: TMessage);
  241. const
  242.   instructions =
  243.     'Click and hold the left mouse button inside'#13+
  244.     'the "Window Information" window. Move the mouse'#13+
  245.     'pointer to any window, and release. You may close'#13+
  246.     'this dialog or leave it open.';
  247. var
  248.   P: TPoint;
  249.   R: TRect;
  250. begin
  251.   if (InfoWin = nil) or (not IsWindow(InfoWin^.HWindow)) then
  252.   begin
  253.     GetClientRect(HWindow, R);
  254.     P.X := R.Right - infoWinWidth;
  255.     P.Y := R.Top;
  256.     ClientToScreen(HWindow, P);
  257.     InfoWin := PTInfoWin(Application^.MakeWindow(New(PTInfoWin, Init(@Self, P))));
  258.     MessageBox(HWindow, instructions, 'Instructions', mb_Ok);
  259.   end else
  260.     SetFocus(InfoWin^.HWindow);
  261. end;
  262.  
  263.  
  264. { Execute the Help menu's About OwlSpy command }
  265.  
  266. procedure TSpyWin.CMHelpAbout(var Msg: TMessage);
  267. var
  268.   Dialog: TDialog;
  269. begin
  270.   Dialog.Init(@Self, PChar(id_About));
  271.   Dialog.Execute;
  272.   Dialog.Done;
  273. end;
  274.  
  275.  
  276. { Respond to mouse movement events }
  277.  
  278. procedure TSpyWin.WMMouseMove(var Msg: TMessage);
  279. begin
  280.   SetCursorInfo(Msg.LParamLo, Msg.LParamHi);
  281.   InvalidateRect(HWindow, nil, false);
  282. end;
  283.  
  284.  
  285. { Capture mouse upon receiving left-mouse-button-down event }
  286.  
  287. procedure TSpyWin.WMLButtonDown(var Msg: TMessage);
  288. begin
  289.   if not ButtonDown then
  290.   begin
  291.     ButtonDown := true;
  292.     SetCapture(HWindow);
  293.     DC := GetDC(HWindow);
  294.     SetCursor(LoadCursor(0, idc_Cross));
  295.   end;
  296. end;
  297.  
  298.  
  299. { Release mouse upon receiving left-mouse-button-up event }
  300.  
  301. procedure TSpyWin.WMLButtonUp(var Msg: TMessage);
  302. begin
  303.   if ButtonDown then
  304.   begin
  305.     ReleaseCapture;
  306.     ReleaseDC(HWindow, DC);
  307.     ButtonDown := false;
  308.     SetCursor(LoadCursor(0, idc_Arrow));
  309.   end;
  310. end;
  311.  
  312.  
  313. { Display information in program's main window }
  314.  
  315. procedure TSpyWin.Paint(PaintDC: HDC; var PaintInfo: TPaintStruct);
  316. var
  317.   S: array[0 .. 20] of Char;
  318. begin
  319.   TWindow.Paint(PaintDC, PaintInfo);
  320.   WVSPrintf(S, 'Local  X = %5d ', Lx);
  321.   TextOut(PaintDC, 10,  10, S, StrLen(S));
  322.   WVSPrintf(S, 'Local  Y = %5d ', Ly);
  323.   TextOut(PaintDC, 10,  40, S, StrLen(S));
  324.   WVSPrintf(S, 'Global X = %5d ', Gx);
  325.   TextOut(PaintDC, 10,  70, S, StrLen(S));
  326.   WVSPrintf(S, 'Global Y = %5d ', Gy);
  327.   TextOut(PaintDC, 10, 100, S, StrLen(S));
  328. end;
  329.  
  330.  
  331. var
  332.  
  333.   SpyApp: TSpyApp;
  334.  
  335.  
  336. begin
  337.   SpyApp.Init('OwlSpy');
  338.   SpyApp.Run;
  339.   SpyApp.Done;
  340. end.
  341.  
  342.  
  343. {--------------------------------------------------------------
  344.   Copyright (c) 1991 by Tom Swan. All rights reserved.
  345.   Revision 1.00    Date: 8/28/1991
  346. ---------------------------------------------------------------}
  347.